home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / nexttsrc.lha / nexttsources / sources / comp / assembler / as_m68.t next >
Encoding:
Text File  |  1988-02-05  |  5.5 KB  |  153 lines
  1. (herald (assembler as_m68 t 0)
  2.         (env t (assembler as)))
  3.  
  4. ;;; Copyright (c) 1985 Yale University
  5. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  6. ;;; This material was developed by the T Project at the Yale University Computer 
  7. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  8. ;;; and to use it for any purpose is granted, subject to the following restric-
  9. ;;; tions and understandings.
  10. ;;; 1. Any copy made of this software must include this copyright notice in full.
  11. ;;; 2. Users of this software agree to make their best efforts (a) to return
  12. ;;;    to the T Project at Yale any improvements or extensions that they make,
  13. ;;;    so that these may be included in future releases; and (b) to inform
  14. ;;;    the T Project of noteworthy uses of this software.
  15. ;;; 3. All materials developed as a consequence of the use of this software
  16. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  17. ;;;    of acknowledging credit in academic research.
  18. ;;; 4. Yale has made no warrantee or representation that the operation of
  19. ;;;    this software will be error-free, and Yale is under no obligation to
  20. ;;;    provide any services, by way of maintenance, update, or otherwise.
  21. ;;; 5. In conjunction with products arising from the use of this material,
  22. ;;;    there shall be no use of the name of the Yale University nor of any
  23. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  24. ;;;    without prior written consent from Yale in each case.
  25. ;;;
  26.  
  27.  
  28. ;;; 68000 machine information
  29.                          
  30. (define *m68-machine* (make-machine))
  31.  
  32. ;;; Create 68000 lap environment under orbit.
  33.  
  34. (new-lap-env *m68-machine* orbit-env '*m68-lap-env*)
  35.  
  36. (define (*define-lap-m68 sym val) 
  37.    (*define-lap *m68-machine* sym val))
  38.  
  39. ;;; Lap interface for the compiler
  40.  
  41. (define (losing-m68-process-lap-list items)
  42.     (if (null? *current-ib*) (emit-tag (generate-symbol 'lap-entry)))
  43.     (process-lap-list items *m68-machine*))
  44.  
  45. (define lap-transduce losing-m68-process-lap-list)
  46.  
  47. ;;; For testing lap
  48.  
  49. (define-syntax (m68lap . items)  
  50.   `(test-lap ',items *m68-machine*))
  51.  
  52. ;;; Some quick definitions for what follows
  53.  
  54. (define *m68-pseudo-operands* 
  55.    (pseudos-alist 
  56.       ((label tag)    (m68/label tag))   
  57.       ((template tag) (m68/label tag))   
  58.       ((to tag)       (data-current-label tag))
  59.       ((static id)    (static id))
  60.       ))
  61.  
  62. ;++ fix the damn compiler!!          
  63.  
  64. (define *m68-pseudo-ops* 
  65.   (append!
  66.    (pseudos-alist 
  67.        ((j=  1tag) (m68-lap-jbcc jump-op/j=  1tag))
  68.        ((jn= 1tag) (m68-lap-jbcc jump-op/jn= 1tag))
  69.        ((j>  1tag) (m68-lap-jbcc jump-op/j>  1tag))
  70.        ((j>= 1tag) (m68-lap-jbcc jump-op/j>= 1tag))
  71.        ((j<  1tag) (m68-lap-jbcc jump-op/j<  1tag))
  72.        ((j<= 1tag) (m68-lap-jbcc jump-op/j<= 1tag))
  73.        ((uj>  1tag) (m68-lap-jbcc jump-op/uj>  1tag))
  74.        ((uj>= 1tag) (m68-lap-jbcc jump-op/uj>= 1tag))
  75.        ((uj<  1tag) (m68-lap-jbcc jump-op/uj<  1tag))
  76.        ((uj<= 1tag) (m68-lap-jbcc jump-op/uj<= 1tag))
  77.        ((jneg 1tag) (m68-lap-jbcc jump-op/negative 1tag))
  78.        ((jpos 1tag) (m68-lap-jbcc jump-op/not_negative 1tag))
  79.        ((jbr 1tag) (m68-lap-jbcc jump-op/jabs 1tag))
  80.      )
  81.     (pseudos-alist
  82.        ((space number)    (m68/space number))
  83.        ;; loser
  84.        ((jump . args)     (apply emit-jump args))       ; -- state machine, ibs
  85.        ;; loser
  86. ;       ((template . args) (apply %emit-template args))  ; -- state machine, ib
  87.        ((byte number) (m68/byte number))
  88.        ((word number) (m68/word number))
  89.        ((long number) (m68/long number))
  90.        ((block . forms) (eval `(block ,@forms) (machine-lap-env *m68-machine*)))
  91.        ((equate id form) (*define-lap-m68 id (eval form (machine-lap-env *m68-machine*))))
  92.        )))
  93.  
  94. (define (m68-lap-jbcc jump-op 1tag)
  95.   (let ((next-tag (generate-symbol 'm68-lap-jbcc)))
  96.     (cond ((not (symbol? 1tag))
  97.            (error "j pseudo ops expect a symbol")))
  98.     (emit-jump-to-ib *current-ib* jump-op 1tag next-tag)
  99.     (emit-tag next-tag)))
  100.  
  101. (*define-lap-m68 'number make-as-number)
  102.     
  103. ;;; Losing near-parameterizations.
  104.  
  105. (define (losing-m68-emit opcode-fg . operands)
  106.   (emit-to-ib *current-ib* (apply opcode-fg operands))
  107.   (flush-delayed-comments))
  108.  
  109. (define (m68emit fg)
  110.   (emit-to-ib *current-ib* fg)
  111.   (flush-delayed-comments))
  112.  
  113. (define %emit losing-m68-emit)
  114.  
  115. (set *pretty-print-tag* pp-ib-as-name-or-hash)
  116. (set *current-machine* *m68-machine*) 
  117.  
  118. ;;; Set machine parameters.
  119.  
  120. ;;; These are in M68IS.
  121. ;(set (machine-template-emitter *m68-machine*) emit-m68-template)
  122. ;(set (machine-cond-branch      *m68-machine*) m68/jbcc)
  123. ;(set (machine-uncond-branch    *m68-machine*) m68/jbra)         
  124.  
  125. (set (machine-clump-size       *m68-machine*) 16)
  126. (set (machine-maximum-clumps   *m68-machine*) 5)
  127. (set (machine-clump-writer     *m68-machine*) m68/write-clumps)
  128. (set (machine-pseudo-ops       *m68-machine*) *m68-pseudo-ops*)
  129. (set (machine-pseudo-operands  *m68-machine*) *m68-pseudo-operands*)
  130.  
  131. ;;; Handy items for lap env
  132.  
  133. (walk *define-lap-m68
  134.       '(r0 r1 r2 r3 r4 r5 r6 r7 r8 r9 r10 r11 r12 r13 r14 r15)
  135.       '( 0  1  2  3  4  5  6  7  8  9  10  11  12  13  14  15)) 
  136.  
  137. (walk *define-lap-m68
  138.       '(.d0 .d1 .d2 .d3 .d4 .d5 .d6 .d7 .a0 .a1 .a2 .a3 .a4 .a5 .a6 .a7)
  139.       '(0    1   2   3   4   5    6  7   8   9  10  11  12  13  14  15))
  140.                                      
  141. (walk *define-lap-m68
  142.       '(S0  S1  S2  S3  S4  S5 SCRATCH  nil-reg P   A1  A2  A3  AN  TP  TASK  SP)
  143.       '(0    1   2   3   4   5       6    7     8   9  10  11  12  13    14  15))
  144.  
  145. (walk *define-lap-m68
  146.       '(.b .w .l)
  147.       '(b w l))
  148.  
  149. (define .b 'b)
  150. (define .w 'w)
  151. (define .l 'l)
  152.  
  153.